home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / gnu / emacs.lha / emacs-19.16 / lisp / modula2.el < prev    next >
Lisp/Scheme  |  1993-03-22  |  13KB  |  455 lines
  1. ;;; modula2.el --- Modula-2 editing support package
  2.  
  3. ;; Author: Michael Schmidt <michael@pbinfo.UUCP> 
  4. ;;    Tom Perrine <Perrin@LOGICON.ARPA>
  5. ;; Keywords: languages
  6.  
  7. ;; The authors distributed this without a copyright notice
  8. ;; back in 1988, so it is in the public domain.  The original included
  9. ;; the following credit:
  10.  
  11. ;; Author Mick Jordan
  12. ;; amended Peter Robinson
  13.  
  14. ;;; Commentary:
  15.  
  16. ;; A major mode for editing Modula-2 code.  It provides convenient abbrevs
  17. ;; for Modula-2 keywords, knows about the standard layout rules, and supports
  18. ;; a native compile command.
  19.  
  20. ;;; Code:
  21.  
  22. ;;; Added by Tom Perrine (TEP)
  23. (defvar m2-mode-syntax-table nil
  24.   "Syntax table in use in Modula-2 buffers.")
  25.  
  26. (defvar m2-compile-command "m2c"
  27.   "Command to compile Modula-2 programs")
  28.  
  29. (defvar m2-link-command "m2l"
  30.   "Command to link Modula-2 programs")
  31.  
  32. (defvar m2-link-name nil
  33.   "Name of the executable.")
  34.  
  35.  
  36. (if m2-mode-syntax-table
  37.     ()
  38.   (let ((table (make-syntax-table)))
  39.     (modify-syntax-entry ?\\ "\\" table)
  40.     (modify-syntax-entry ?\( ". 1" table)
  41.     (modify-syntax-entry ?\) ". 4" table)
  42.     (modify-syntax-entry ?* ". 23" table)
  43.     (modify-syntax-entry ?+ "." table)
  44.     (modify-syntax-entry ?- "." table)
  45.     (modify-syntax-entry ?= "." table)
  46.     (modify-syntax-entry ?% "." table)
  47.     (modify-syntax-entry ?< "." table)
  48.     (modify-syntax-entry ?> "." table)
  49.     (modify-syntax-entry ?\' "\"" table)
  50.     (setq m2-mode-syntax-table table)))
  51.  
  52. ;;; Added by TEP
  53. (defvar m2-mode-map nil
  54.   "Keymap used in Modula-2 mode.")
  55.  
  56. (if m2-mode-map ()
  57.   (let ((map (make-sparse-keymap)))
  58.     (define-key map "\^i" 'm2-tab)
  59.     (define-key map "\C-cb" 'm2-begin)
  60.     (define-key map "\C-cc" 'm2-case)
  61.     (define-key map "\C-cd" 'm2-definition)
  62.     (define-key map "\C-ce" 'm2-else)
  63.     (define-key map "\C-cf" 'm2-for)
  64.     (define-key map "\C-ch" 'm2-header)
  65.     (define-key map "\C-ci" 'm2-if)
  66.     (define-key map "\C-cm" 'm2-module)
  67.     (define-key map "\C-cl" 'm2-loop)
  68.     (define-key map "\C-co" 'm2-or)
  69.     (define-key map "\C-cp" 'm2-procedure)
  70.     (define-key map "\C-c\C-w" 'm2-with)
  71.     (define-key map "\C-cr" 'm2-record)
  72.     (define-key map "\C-cs" 'm2-stdio)
  73.     (define-key map "\C-ct" 'm2-type)
  74.     (define-key map "\C-cu" 'm2-until)
  75.     (define-key map "\C-cv" 'm2-var)
  76.     (define-key map "\C-cw" 'm2-while)
  77.     (define-key map "\C-cx" 'm2-export)
  78.     (define-key map "\C-cy" 'm2-import)
  79.     (define-key map "\C-c{" 'm2-begin-comment)
  80.     (define-key map "\C-c}" 'm2-end-comment)
  81.     (define-key map "\C-j"  'm2-newline)
  82.     (define-key map "\C-c\C-z" 'suspend-emacs)
  83.     (define-key map "\C-c\C-v" 'm2-visit)
  84.     (define-key map "\C-c\C-t" 'm2-toggle)
  85.     (define-key map "\C-c\C-l" 'm2-link)
  86.     (define-key map "\C-c\C-c" 'm2-compile)
  87.     (setq m2-mode-map map)))
  88.  
  89. (defvar m2-indent 5 "*This variable gives the indentation in Modula-2-Mode")
  90.   
  91. ;;;###autoload
  92. (defun modula-2-mode ()
  93.   "This is a mode intended to support program development in Modula-2.
  94. All control constructs of Modula-2 can be reached by typing C-c
  95. followed by the first character of the construct.
  96. \\<m2-mode-map>
  97.   \\[m2-begin] begin         \\[m2-case] case
  98.   \\[m2-definition] definition    \\[m2-else] else
  99.   \\[m2-for] for           \\[m2-header] header
  100.   \\[m2-if] if            \\[m2-module] module
  101.   \\[m2-loop] loop          \\[m2-or] or
  102.   \\[m2-procedure] procedure     Control-c Control-w with
  103.   \\[m2-record] record        \\[m2-stdio] stdio
  104.   \\[m2-type] type          \\[m2-until] until
  105.   \\[m2-var] var           \\[m2-while] while
  106.   \\[m2-export] export        \\[m2-import] import
  107.   \\[m2-begin-comment] begin-comment \\[m2-end-comment] end-comment
  108.   \\[suspend-emacs] suspend Emacs     \\[m2-toggle] toggle
  109.   \\[m2-compile] compile           \\[m2-next-error] next-error
  110.   \\[m2-link] link
  111.  
  112.    `m2-indent' controls the number of spaces for each indentation.
  113.    `m2-compile-command' holds the command to compile a Modula-2 program.
  114.    `m2-link-command' holds the command to link a Modula-2 program."
  115.   (interactive)
  116.   (kill-all-local-variables)
  117.   (use-local-map m2-mode-map)
  118.   (setq major-mode 'modula-2-mode)
  119.   (setq mode-name "Modula-2")
  120.   (make-local-variable 'comment-column)
  121.   (setq comment-column 41)
  122.   (make-local-variable 'end-comment-column)
  123.   (setq end-comment-column 75)
  124.   (set-syntax-table m2-mode-syntax-table)
  125.   (make-local-variable 'paragraph-start)
  126.   (setq paragraph-start (concat "^$\\|" page-delimiter))
  127.   (make-local-variable 'paragraph-separate)
  128.   (setq paragraph-separate paragraph-start)
  129.   (make-local-variable 'paragraph-ignore-fill-prefix)
  130.   (setq paragraph-ignore-fill-prefix t)
  131. ;  (make-local-variable 'indent-line-function)
  132. ;  (setq indent-line-function 'c-indent-line)
  133.   (make-local-variable 'require-final-newline)
  134.   (setq require-final-newline t)
  135.   (make-local-variable 'comment-start)
  136.   (setq comment-start "(* ")
  137.   (make-local-variable 'comment-end)
  138.   (setq comment-end " *)")
  139.   (make-local-variable 'comment-column)
  140.   (setq comment-column 41)
  141.   (make-local-variable 'comment-start-skip)
  142.   (setq comment-start-skip "/\\*+ *")
  143.   (make-local-variable 'comment-indent-function)
  144.   (setq comment-indent-function 'c-comment-indent)
  145.   (make-local-variable 'parse-sexp-ignore-comments)
  146.   (setq parse-sexp-ignore-comments t)
  147.   (run-hooks 'm2-mode-hook))
  148.  
  149. (defun m2-newline ()
  150.   "Insert a newline and indent following line like previous line."
  151.   (interactive)
  152.   (let ((hpos (current-indentation)))
  153.     (newline)
  154.     (indent-to hpos)))
  155.  
  156. (defun m2-tab ()
  157.   "Indent to next tab stop."
  158.   (interactive)
  159.   (indent-to (* (1+ (/ (current-indentation) m2-indent)) m2-indent)))
  160.  
  161. (defun m2-begin ()
  162.   "Insert a BEGIN keyword and indent for the next line."
  163.   (interactive)
  164.   (insert "BEGIN")
  165.   (m2-newline)
  166.   (m2-tab))
  167.  
  168. (defun m2-case ()
  169.   "Build skeleton CASE statment, prompting for the <expression>."
  170.   (interactive)
  171.   (let ((name (read-string "Case-Expression: ")))
  172.     (insert "CASE " name " OF")
  173.     (m2-newline)
  174.     (m2-newline)
  175.     (insert "END (* case " name " *);"))
  176.   (end-of-line 0)
  177.   (m2-tab))
  178.  
  179. (defun m2-definition ()
  180.   "Build skeleton DEFINITION MODULE, prompting for the <module name>."
  181.   (interactive)
  182.   (insert "DEFINITION MODULE ")
  183.   (let ((name (read-string "Name: ")))
  184.     (insert name ";\n\n\n\nEND " name ".\n"))
  185.   (previous-line 3))
  186.  
  187. (defun m2-else ()
  188.   "Insert ELSE keyword and indent for next line."
  189.   (interactive)
  190.   (m2-newline)
  191.   (backward-delete-char-untabify m2-indent ())
  192.   (insert "ELSE")
  193.   (m2-newline)
  194.   (m2-tab))
  195.  
  196. (defun m2-for ()
  197.   "Build skeleton FOR loop statment, prompting for the loop parameters."
  198.   (interactive)
  199.   (insert "FOR ")
  200.   (let ((name (read-string "Loop Initialiser: ")) limit by)
  201.     (insert name " TO ")
  202.     (setq limit (read-string "Limit: "))
  203.     (insert limit)
  204.     (setq by (read-string "Step: "))
  205.     (if (not (string-equal by ""))
  206.     (insert " BY " by))
  207.     (insert " DO")
  208.     (m2-newline)
  209.     (m2-newline)
  210.     (insert "END (* for " name " to " limit " *);"))
  211.   (end-of-line 0)
  212.   (m2-tab))
  213.  
  214. (defun m2-header ()
  215.   "Insert a comment block containing the module title, author, etc."
  216.   (interactive)
  217.   (insert "(*\n    Title: \t")
  218.   (insert (read-string "Title: "))
  219.   (insert "\n    Created:\t")
  220.   (insert (current-time-string))
  221.   (insert "\n    Author: \t")
  222.   (insert (user-full-name))
  223.   (insert (concat "\n\t\t<" (user-login-name) "@" (system-name) ">\n"))
  224.   (insert "*)\n\n"))
  225.  
  226. (defun m2-if ()
  227.   "Insert skeleton IF statment, prompting for <boolean-expression>."
  228.   (interactive)
  229.   (insert "IF ")
  230.   (let ((thecondition (read-string "<boolean-expression>: ")))
  231.     (insert thecondition " THEN")
  232.     (m2-newline)
  233.     (m2-newline)
  234.     (insert "END (* if " thecondition " *);"))
  235.   (end-of-line 0)
  236.   (m2-tab))
  237.  
  238. (defun m2-loop ()
  239.   "Build skeleton LOOP (with END)."
  240.   (interactive)
  241.   (insert "LOOP")
  242.   (m2-newline)
  243.   (m2-newline)
  244.   (insert "END (* loop *);")
  245.   (end-of-line 0)
  246.   (m2-tab))
  247.  
  248. (defun m2-module ()
  249.   "Build skeleton IMPLEMENTATION MODULE, prompting for <module-name>."
  250.   (interactive)
  251.   (insert "IMPLEMENTATION MODULE ")
  252.   (let ((name (read-string "Name: ")))
  253.     (insert name ";\n\n\n\nEND " name ".\n")
  254.     (previous-line 3)
  255.     (m2-header)
  256.     (m2-type)
  257.     (newline)
  258.     (m2-var)
  259.     (newline)
  260.     (m2-begin)
  261.     (m2-begin-comment)
  262.     (insert " Module " name " Initialisation Code "))
  263.   (m2-end-comment)
  264.   (newline)
  265.   (m2-tab))
  266.  
  267. (defun m2-or ()
  268.   (interactive)
  269.   (m2-newline)
  270.   (backward-delete-char-untabify m2-indent)
  271.   (insert "|")
  272.   (m2-newline)
  273.   (m2-tab))
  274.  
  275. (defun m2-procedure ()
  276.   (interactive)
  277.   (insert "PROCEDURE ")
  278.   (let ((name (read-string "Name: " ))
  279.     args)
  280.     (insert name " (")
  281.     (insert (read-string "Arguments: ") ")")
  282.     (setq args (read-string "Result Type: "))
  283.     (if (not (string-equal args ""))
  284.     (insert " : " args))
  285.     (insert ";")
  286.     (m2-newline)
  287.     (insert "BEGIN")
  288.     (m2-newline)
  289.     (m2-newline)
  290.     (insert "END ")
  291.     (insert name)
  292.     (insert ";")
  293.     (end-of-line 0)
  294.     (m2-tab)))
  295.  
  296. (defun m2-with ()
  297.   (interactive)
  298.   (insert "WITH ")
  299.   (let ((name (read-string "Record-Type: ")))
  300.     (insert name)
  301.     (insert " DO")
  302.     (m2-newline)
  303.     (m2-newline)
  304.     (insert "END (* with " name " *);"))
  305.   (end-of-line 0)
  306.   (m2-tab))
  307.  
  308. (defun m2-record ()
  309.   (interactive)
  310.   (insert "RECORD")
  311.   (m2-newline)
  312.   (m2-newline)
  313.   (insert "END (* record *);")
  314.   (end-of-line 0)
  315.   (m2-tab))
  316.  
  317. (defun m2-stdio ()
  318.   (interactive)
  319.   (insert "
  320. FROM TextIO IMPORT 
  321.    WriteCHAR, ReadCHAR, WriteINTEGER, ReadINTEGER,
  322.    WriteCARDINAL, ReadCARDINAL, WriteBOOLEAN, ReadBOOLEAN,
  323.    WriteREAL, ReadREAL, WriteBITSET, ReadBITSET,
  324.    WriteBasedCARDINAL, ReadBasedCARDINAL, WriteChars, ReadChars,
  325.    WriteString, ReadString, WhiteSpace, EndOfLine;
  326.  
  327. FROM SysStreams IMPORT sysIn, sysOut, sysErr;
  328.  
  329. "))
  330.  
  331. (defun m2-type ()
  332.   (interactive)
  333.   (insert "TYPE")
  334.   (m2-newline)
  335.   (m2-tab))
  336.  
  337. (defun m2-until ()
  338.   (interactive)
  339.   (insert "REPEAT")
  340.   (m2-newline)
  341.   (m2-newline)
  342.   (insert "UNTIL ")
  343.   (insert (read-string "<boolean-expression>: ") ";")
  344.   (end-of-line 0)
  345.   (m2-tab))
  346.  
  347. (defun m2-var ()
  348.   (interactive)
  349.   (m2-newline)
  350.   (insert "VAR")
  351.   (m2-newline)
  352.   (m2-tab))
  353.  
  354. (defun m2-while ()
  355.   (interactive)
  356.   (insert "WHILE ")
  357.   (let ((name (read-string "<boolean-expression>: ")))
  358.     (insert name " DO" )
  359.     (m2-newline)
  360.     (m2-newline)
  361.     (insert "END (* while " name " *);"))
  362.   (end-of-line 0)
  363.   (m2-tab))
  364.  
  365. (defun m2-export ()
  366.   (interactive)
  367.   (insert "EXPORT QUALIFIED "))
  368.  
  369. (defun m2-import ()
  370.   (interactive)
  371.   (insert "FROM ")
  372.   (insert (read-string "Module: "))
  373.   (insert " IMPORT "))
  374.  
  375. (defun m2-begin-comment ()
  376.   (interactive)
  377.   (if (not (bolp))
  378.       (indent-to comment-column 0))
  379.   (insert "(*  "))
  380.  
  381. (defun m2-end-comment ()
  382.   (interactive)
  383.   (if (not (bolp))
  384.       (indent-to end-comment-column))
  385.   (insert "*)"))
  386.  
  387. (defun m2-compile ()
  388.   (interactive)
  389.   (setq modulename (buffer-name))
  390.   (compile (concat m2-compile-command " " modulename)))
  391.  
  392. (defun m2-link ()
  393.   (interactive)
  394.   (setq modulename (buffer-name))
  395.   (if m2-link-name
  396.       (compile (concat m2-link-command " " m2-link-name))
  397.     (compile (concat m2-link-command " "
  398.              (setq m2-link-name (read-string "Name of executable: "
  399.                              modulename))))))
  400.  
  401. (defun execute-monitor-command (command)
  402.   (let* ((shell shell-file-name)
  403.      (csh (equal (file-name-nondirectory shell) "csh")))
  404.     (call-process shell nil t t "-cf" (concat "exec " command))))
  405.  
  406. (defun m2-visit ()
  407.   (interactive)
  408.   (let ((deffile nil)
  409.     (modfile nil)
  410.     modulename)
  411.     (save-excursion
  412.       (setq modulename
  413.         (read-string "Module name: "))
  414.       (switch-to-buffer "*Command Execution*")
  415.       (execute-monitor-command (concat "m2whereis " modulename))
  416.       (goto-char (point-min))
  417.       (condition-case ()
  418.       (progn (re-search-forward "\\(.*\\.def\\) *$")
  419.          (setq deffile (buffer-substring (match-beginning 1)
  420.                          (match-end 1))))
  421.     (search-failed ()))
  422.       (condition-case ()
  423.       (progn (re-search-forward "\\(.*\\.mod\\) *$")
  424.          (setq modfile (buffer-substring (match-beginning 1)
  425.                          (match-end 1))))
  426.     (search-failed ()))
  427.       (if (not (or deffile modfile))
  428.       (error "I can find neither definition nor implementation of %s"
  429.          modulename)))
  430.     (cond (deffile
  431.         (find-file deffile)
  432.         (if modfile
  433.         (save-excursion
  434.           (find-file modfile))))
  435.       (modfile
  436.        (find-file modfile)))))
  437.  
  438. (defun m2-toggle ()
  439.   "Toggle between .mod and .def files for the module."
  440.   (interactive)
  441.   (cond ((string-equal (substring (buffer-name) -4) ".def")
  442.      (find-file-other-window
  443.       (concat (substring (buffer-name) 0 -4) ".mod")))
  444.     ((string-equal (substring (buffer-name) -4) ".mod")
  445.      (find-file-other-window
  446.       (concat (substring (buffer-name) 0 -4)  ".def")))
  447.     ((string-equal (substring (buffer-name) -3) ".mi")
  448.      (find-file-other-window
  449.       (concat (substring (buffer-name) 0 -3)  ".md")))
  450.     ((string-equal (substring (buffer-name) -3) ".md")
  451.      (find-file-other-window
  452.       (concat (substring (buffer-name) 0 -3)  ".mi")))))
  453.  
  454. ;;; modula2.el ends here
  455.